home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / oberonv4 / oberon-src / system / amigaiff.mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1996-03-19  |  11.2 KB  |  341 lines
  1. Syntax20b.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax24b.Scn.Fnt
  5. Syntax10.Scn.Fnt
  6. Syntax10b.Scn.Fnt
  7. FoldElems
  8. (* AMIGA *)
  9. MODULE AmigaIFF; (* Ralf Degner 04.08.1995 *)
  10. IMPORT
  11.     SYSTEM, i:=AmigaIFFParse, Amiga, G:=AmigaGraphics, Display, Pictures, PictureFrames, Log;
  12. CONST
  13.     FORM*=0464F524DH; FTXT*=046545854H; CHRS*=043485253H; OBRO*=04F42524FH;
  14.     ILBM*=0494C424DH; BMHD*=424D4844H; CMAP*=434D4150H; CAMG*=43414D47H; BODY*=0424F4459H;
  15.     mskNone*=0; mskHasMask*=1; cmpNone*=0; cmpByteRun1*=1; (* for Bitmapheader *)
  16.     BitmapHeaderPtr*= POINTER TO BitmapHeader;
  17.     BitmapHeader*= RECORD
  18.         w*, h*, x*, y*: INTEGER;
  19.         nPlanes*: CHAR;
  20.         masking*, compression*, pad1*: SHORTINT;
  21.         transparentColor*: INTEGER;
  22.         xAspect*, yAspect*: SHORTINT;
  23.         pageWidth*, pageHeight*: INTEGER
  24.     END;
  25. (* Test Color of a Picture, if there is only black, use Colors of Display *)
  26. PROCEDURE TestSetPictColor(P: Pictures.Picture);
  27.         i, k, r, g, b: INTEGER;
  28.         status: BOOLEAN;
  29. BEGIN
  30.     status:=FALSE;k:=SHORT(ASH(1, P.depth));i:=0;
  31.     REPEAT
  32.         Pictures.GetColor(P, i, r, g, b);
  33.         status:=status OR (r#0) OR (g#0) OR (b#0);
  34.         INC(i)
  35.     UNTIL status OR (i=k);
  36.     IF ~status THEN
  37.         FOR i:=0 TO ASH(1, P.depth)-1 DO
  38.             Display.GetColor(i,r,g,b);
  39.             Pictures.SetColor(P,i,r,g,b)
  40.         END
  41. END TestSetPictColor;
  42. (* Procedures for working with ILBMs *)
  43. PROCEDURE StoreBMHD*(iff: i.IFFHandlePtr; w, h, planes: INTEGER; compr: SHORTINT);
  44.         b: BitmapHeader;
  45.         error: LONGINT;
  46. BEGIN
  47.     b.w:=w; b.h:=h; b.x:=0; b.y:=0; b.nPlanes:=CHR(planes);
  48.     b.masking:=mskNone; b.compression:=compr; b.pad1:=0;
  49.     b.transparentColor:=0; b.xAspect:=1; b.yAspect:=1;
  50.     b.pageWidth:=w; b.pageHeight:=h;
  51.     IF i.PushChunk(iff, 0, BMHD, i.sizeUnknown)=0 THEN
  52.         error:=i.WriteChunkBytes(iff, SYSTEM.ADR(b), SIZE(BitmapHeader));
  53.         error:=i.PopChunk(iff)
  54. END StoreBMHD;
  55. PROCEDURE LoadDisplayColors*(iff: i.IFFHandlePtr);
  56.         buffer: ARRAY 768 OF CHAR;
  57.         n, anz: LONGINT;
  58.         Count: INTEGER;
  59.         cn: i.ContextNodePtr;
  60. BEGIN
  61.     IF i.StopChunk(iff, ILBM, CMAP)=0 THEN
  62.         IF i.ParseIFF(iff, i.parseScan)=0 THEN
  63.             cn:=i.CurrentChunk(iff);
  64.             IF cn#NIL THEN
  65.                 anz:=(i.ReadChunkBytes(iff, SYSTEM.ADR(buffer), 768)) DIV 3;
  66.                 n:=ASH(1, Amiga.Depth);
  67.                 IF anz<n THEN n:=anz END;
  68.                 FOR Count:=0 TO n-1 DO
  69.                     Display.SetColor(Count, ORD(buffer[Count*3]), ORD(buffer[Count*3+1]), ORD(buffer[Count*3+2]))
  70.                 END
  71.             END
  72.         END
  73. END LoadDisplayColors;
  74. PROCEDURE StoreDisplayColors*(iff: i.IFFHandlePtr);
  75.         buffer: ARRAY 768 OF CHAR;
  76.         n, error: LONGINT;
  77.         Count, r, g, b: INTEGER;
  78. BEGIN
  79.     IF i.PushChunk(iff, 0, CMAP, i.sizeUnknown)=0 THEN
  80.         n:=ASH(1, Amiga.Depth);
  81.         FOR Count:=0 TO n-1 DO
  82.             Display.GetColor(Count, r, g, b);
  83.             buffer[Count*3]:=CHR(r);
  84.             buffer[Count*3+1]:=CHR(g);
  85.             buffer[Count*3+2]:=CHR(b)
  86.         END;
  87.         error:=i.WriteChunkBytes(iff, SYSTEM.ADR(buffer), n*3);
  88.         error:=i.PopChunk(iff)
  89. END StoreDisplayColors;
  90. PROCEDURE StorePictureColors*(iff: i.IFFHandlePtr; pict: Pictures.Picture);
  91.         buffer: ARRAY 768 OF CHAR;
  92.         n, error: LONGINT;
  93.         Count, r, g, b: INTEGER;
  94. BEGIN
  95.     IF i.PushChunk(iff, 0, CMAP, i.sizeUnknown)=0 THEN
  96.         TestSetPictColor(pict);
  97.         n:=ASH(1, pict.depth);
  98.         FOR Count:=0 TO n-1 DO
  99.             Pictures.GetColor(pict, Count, r, g, b);
  100.             buffer[Count*3]:=CHR(r);
  101.             buffer[Count*3+1]:=CHR(g);
  102.             buffer[Count*3+2]:=CHR(b)
  103.         END;
  104.         error:=i.WriteChunkBytes(iff, SYSTEM.ADR(buffer), n*3);
  105.         error:=i.PopChunk(iff)
  106. END StorePictureColors;
  107. PROCEDURE StoreILBMBody*(iff: i.IFFHandlePtr; rastport: LONGINT; w, h, d: INTEGER);
  108.         maps: ARRAY 8 OF LONGINT;
  109.         error, plane, line: LONGINT;
  110.         wb, bpr: LONGINT;
  111.         bm: G.BitMapPointer;
  112.         rp: G.RastPortPointer;
  113. BEGIN
  114.     IF i.PushChunk(iff, 0, BODY, i.sizeUnknown)=0 THEN
  115.         rp:=SYSTEM.VAL(G.RastPortPointer, rastport);
  116.         bm:=SYSTEM.VAL(G.BitMapPointer, rp.bitMap);
  117.         wb:=((w+15)DIV 16)*2;
  118.         bpr:=bm.bytesPerRow;
  119.         FOR plane:=0 TO d-1 DO
  120.             maps[plane]:=bm.planes[plane]
  121.         END;
  122.         FOR line:=0 TO h-1 DO
  123.             FOR plane:=0 TO d-1 DO
  124.                 error:=i.WriteChunkBytes(iff, maps[plane], wb);
  125.                 INC(maps[plane], bpr)
  126.             END
  127.         END;
  128.         error:=i.PopChunk(iff)
  129. END StoreILBMBody;
  130. PROCEDURE StoreDisplayAsILBM*(iff: i.IFFHandlePtr);
  131.     VAR error: LONGINT;
  132. BEGIN
  133.     IF i.PushChunk(iff, ILBM, FORM, i.sizeUnknown)=0 THEN
  134.         StoreBMHD(iff, Amiga.Width, Amiga.Height, Amiga.Depth, cmpNone);
  135.         StoreDisplayColors(iff);
  136.         StoreILBMBody(iff, Amiga.rp, Amiga.Width, Amiga.Height, Amiga.Depth);
  137.         error:=i.PopChunk(iff)
  138. END StoreDisplayAsILBM;
  139. PROCEDURE StorePictAsILBM*(iff: i.IFFHandlePtr; p: Pictures.Picture);
  140.         error: LONGINT;
  141.         l: G.LayerPointer;
  142. BEGIN
  143.     IF p#NIL THEN
  144.         IF i.PushChunk(iff, ILBM, FORM, i.sizeUnknown)=0 THEN
  145.             l:=SYSTEM.VAL(G.LayerPointer, p.layer);
  146.             StoreBMHD(iff, p.width, p.height, p.depth, cmpNone);
  147.             StorePictureColors(iff, p);
  148.             StoreILBMBody(iff, l.rp, p.width, p.height, p.depth);
  149.             error:=i.PopChunk(iff)
  150.         END
  151. END StorePictAsILBM;
  152. PROCEDURE LoadPictBitmap(iff: i.IFFHandlePtr; p: Pictures.Picture; w, h, d, iffd, comp: INTEGER);
  153.         maps: ARRAY 8 OF LONGINT;
  154.         error, plane, line, len, ptr: LONGINT;
  155.         wb, bpr, restb: LONGINT;
  156.         la: G.LayerPointer;
  157.         bm: G.BitMapPointer;
  158.         rp: G.RastPortPointer;
  159.         DumBuf, DumBuf2: ARRAY 4096 OF CHAR;
  160.         DumAdr: LONGINT;
  161.     PROCEDURE GetByte(): CHAR;
  162.     BEGIN
  163.         INC(ptr);
  164.         IF ptr>=len THEN
  165.             len:=i.ReadChunkBytes(iff, DumAdr, 4096);
  166.             ptr:=0
  167.         END;
  168.         RETURN DumBuf[ptr]
  169.     END GetByte;
  170.     PROCEDURE ReadPackedLine(Dest: LONGINT);
  171.         VAR
  172.             Nr: LONGINT;
  173.             Wert: SHORTINT;
  174.             Count: INTEGER;
  175.             ch: CHAR;
  176.     BEGIN
  177.         Nr:=0;
  178.         REPEAT
  179.             Wert:=SYSTEM.VAL(SHORTINT, GetByte());
  180.             IF Wert>=0 THEN
  181.                 FOR Count:=0 TO Wert DO
  182.                     ch:=GetByte();
  183.                     IF Nr<bpr THEN SYSTEM.PUT(Nr+Dest, ch) END;
  184.                     INC(Nr)
  185.                 END
  186.             ELSIF Wert#-128 THEN
  187.                 ch:=GetByte();
  188.                 FOR Count:=0 TO ABS(Wert) DO
  189.                     IF Nr<bpr THEN SYSTEM.PUT(Nr+Dest, ch) END;
  190.                     INC(Nr)
  191.                 END
  192.             END
  193.         UNTIL Nr=wb
  194.     END ReadPackedLine;
  195.     PROCEDURE SkipPackedLine();
  196.         VAR
  197.             Nr: LONGINT;
  198.             Wert: SHORTINT;
  199.             Count: INTEGER;
  200.             ch: CHAR;
  201.     BEGIN
  202.         Nr:=0;
  203.         REPEAT
  204.             Wert:=SYSTEM.VAL(SHORTINT, GetByte());
  205.             IF Wert>=0 THEN
  206.                 FOR Count:=0 TO Wert DO
  207.                     ch:=GetByte();
  208.                     INC(Nr)
  209.                 END
  210.             ELSIF Wert#-128 THEN
  211.                 ch:=GetByte();
  212.                 FOR Count:=0 TO ABS(Wert) DO
  213.                     INC(Nr)
  214.                 END
  215.             END
  216.         UNTIL Nr=wb
  217.     END SkipPackedLine;
  218. BEGIN
  219.     la:=SYSTEM.VAL(G.LayerPointer, p.layer);
  220.     rp:=SYSTEM.VAL(G.RastPortPointer, la.rp);
  221.     bm:=SYSTEM.VAL(G.BitMapPointer, rp.bitMap);
  222.     bpr:=bm.bytesPerRow;
  223.     wb:=((w+15) DIV 16)*2;
  224.     restb:=wb-bpr; IF restb<0 THEN restb:=0 END;
  225.     DumAdr:=SYSTEM.ADR(DumBuf);
  226.     FOR plane:=0 TO d-1 DO
  227.         maps[plane]:=bm.planes[plane]
  228.     END;
  229.     IF comp=0 THEN                            (* No Compression *)
  230.         FOR line:=0 TO h-1 DO
  231.             FOR plane:=0 TO iffd-1 DO
  232.                 IF plane<d THEN
  233.                     error:=i.ReadChunkBytes(iff, maps[plane], bpr);
  234.                     INC(maps[plane], bpr);
  235.                     IF restb#0 THEN
  236.                         error:=i.ReadChunkBytes(iff, DumAdr, restb)
  237.                     END
  238.                 ELSE
  239.                     error:=i.ReadChunkBytes(iff, DumAdr, wb)
  240.                 END
  241.             END
  242.         END
  243.     ELSIF comp=cmpByteRun1 THEN        (* ByteRun1 Copression *)
  244.         len:=0; ptr:=0;
  245.         FOR line:=0 TO h-1 DO
  246.             FOR plane:=0 TO iffd-1 DO
  247.                 IF plane<d THEN
  248.                     ReadPackedLine(maps[plane]);
  249.                     INC(maps[plane], bpr)
  250.                 ELSE
  251.                     ReadPackedLine(SYSTEM.ADR(DumBuf2))
  252.                 END
  253.             END
  254.         END
  255. END LoadPictBitmap;
  256. PROCEDURE LoadILBMToPict*(iff: i.IFFHandlePtr): Pictures.Picture;
  257.         len, colors: LONGINT;
  258.         cn: i.ContextNodePtr;
  259.         bh: BitmapHeader;
  260.         CB: ARRAY 768 OF CHAR;
  261.         bhLoaded: BOOLEAN;
  262.         P: Pictures.Picture;
  263.         Planes, Count, OriPlanes: INTEGER;
  264. BEGIN
  265.     colors:=0; bhLoaded:=FALSE;
  266.     IF (i.StopChunk(iff, ILBM, BMHD)=0)
  267.     & (i.StopChunk(iff, ILBM, CMAP)=0)
  268.     & (i.StopChunk(iff, ILBM, BODY)=0) THEN
  269.         WHILE i.ParseIFF(iff, i.parseScan)=0 DO
  270.             cn:=i.CurrentChunk(iff);
  271.             IF cn.id=BMHD THEN
  272.                 IF bhLoaded THEN RETURN NIL END;
  273.                 len:=i.ReadChunkBytes(iff, SYSTEM.ADR(bh), SIZE(BitmapHeader));
  274.                 IF len=SIZE(BitmapHeader) THEN bhLoaded:=TRUE; Planes:=ORD(bh.nPlanes) END
  275.             ELSIF cn.id=CMAP THEN
  276.                 len:=i.ReadChunkBytes(iff, SYSTEM.ADR(CB), 768);
  277.                 colors:=len DIV 3
  278.             ELSIF cn.id=BODY THEN
  279.                 IF bhLoaded THEN
  280.                     OriPlanes:=ORD(bh.nPlanes);
  281.                     IF bh.masking=mskHasMask THEN INC(OriPlanes) END;
  282.                     IF colors#ASH(1, OriPlanes) THEN
  283.                         Log.Str("Can not load HAM or EHB pictures !"); Log.Ln;
  284.                         RETURN NIL
  285.                     END;
  286.                     IF (bh.compression#0) & (bh.compression#cmpByteRun1) THEN
  287.                         Log.Str("Unknown compression !");Log.Ln; RETURN NIL
  288.                     END;
  289.                     NEW(P); P.notify:=PictureFrames.NotifyDisplay;
  290.                     IF Planes>Amiga.Depth THEN Planes:=Amiga.Depth END;
  291.                     Pictures.Create(P, bh.w, bh.h, Planes);
  292.                     IF P=NIL THEN RETURN NIL END;
  293.                     P.notify := PictureFrames.NotifyDisplay;
  294.                     LoadPictBitmap(iff, P, bh.w, bh.h, Planes, OriPlanes, bh.compression);
  295.                     IF colors#0 THEN
  296.                         FOR Count:=0 TO colors-1 DO
  297.                             Pictures.SetColor(P, Count, ORD(CB[Count*3]), ORD(CB[Count*3+1]), ORD(CB[Count*3+2]))
  298.                         END
  299.                     END;
  300.                     RETURN P
  301.                 END
  302.             END
  303.         END
  304. END LoadILBMToPict;
  305. PROCEDURE FitColors*(P: Pictures.Picture);
  306.         Map, dr, dg, db: ARRAY 256 OF INTEGER;
  307.         CountP, CountD: INTEGER;
  308.         r, g, b, Col, x, y: INTEGER;
  309.         sr, sg, sb, n, l: LONGINT;
  310. BEGIN
  311.     Log.Str("Saerching for new colors ..."); Log.Ln;
  312.     FOR CountD:=0 TO 255 DO
  313.         Display.GetColor(CountD, dr[CountD], dg[CountD], db[CountD])
  314.     END;
  315.     FOR CountP:=0 TO ASH(1, P.depth)-1 DO
  316.         Pictures.GetColor(P, CountP, r, g, b);
  317.         l:=256*256*3;
  318.         FOR CountD:=0 TO ASH(1, Amiga.Depth)-1 DO
  319.             sr:=dr[CountD]-r; sg:=dg[CountD]-g; sb:=db[CountD]-b;
  320.             n:=sr*sr+sg*sg+sb*sb;
  321.             IF n<l THEN l:=n; Col:=CountD END
  322.         END;
  323.         Map[CountP]:=Col
  324.     END;
  325.     Log.Str("Converting picture ");
  326.     FOR x:=0 TO P.width-1 DO
  327.         IF (x MOD 16)=0 THEN Log.Ch(".") END;
  328.         FOR y:=0 TO P.height-1 DO
  329.             Pictures.Dot(P, Map[Pictures.Get(P, x, y)], x, y, Display.replace)
  330.         END
  331.     END;
  332.     P.depth:=Amiga.Depth;
  333.     FOR CountD:=0 TO ASH(1, P.depth)-1 DO
  334.         Pictures.SetColor(P, CountD, dr[CountD], dg[CountD], db[CountD])
  335.     END;
  336.     Log.Ln;
  337.     Pictures.Update(P, 0, 0, P.width, P.height)
  338. END FitColors;
  339. END AmigaIFF.
  340. System.Free AmigaIFF ~
  341.